#lang scheme

(require (lib "1.ss" "srfi")
         "utils.scm")

(provide next-deBruijn-symbol)

(define deBruijn-hash (make-hash))

(define (all-comb len a)
  (if (= 1 len)
      (map list a)
      (for*/list ((x a)
                  (l (all-comb (- len 1) a)))
                 (cons x l))))

(define (remaining-subsequences l a (len 1))
  (let* ((sublists (unfold (lambda (l) (empty? (drop l (- len 1))))
                           (lambda (l) (take l len))
                           cdr l))
         (remaining (filter-map (lambda (x) (if (member x sublists) #f x))
                                (all-comb len a))))
    (if (empty? remaining)
        (remaining-subsequences l a (+ len 1))
        remaining)))


(define (best-seq start rest (depth ""))
;  (printd "~v~s ~s~n" depth start rest)
;  (printd "~v~s~n" depth deBruijn-hash)
  (hash-ref!
   deBruijn-hash (cons start rest)
   (begin
     (if (null? rest)
         '(0 . ())
         (let loop ((s2 rest)
                    (s1 empty)
                    (new-best '(0)))
;           (printd "~vs2=~s~n~vs1=~s~n~vnew-best=~s~n" depth s2 depth s1 depth new-best)
           (if (empty? s2)
               new-best
               (loop
                (cdr s2)
                (cons (car s2) s1)
                (let* ((y (best-seq (car s2)
                                    (append s1 (cdr s2))
                                    (string-append depth "  ")))
                       (y (cons (+ (overlap start (car s2)) (car y))
                                (cons (car s2) (cdr y)))))
;                  (printd "~vy=~s~n" depth y)
                  (if (> (car new-best) (car y)) new-best y)))))))))


(define (next-deBruijn-symbol l a)
  (if (null? l)
      (car a)
      (let* ((rest (remaining-subsequences l a))
             (next (cadr (best-seq (take-right l (length (car rest))) rest))))
        (printd "next-deBruijn-symbol=~s~n" next)
        (list-ref next (overlap l next)))))

;(next-deBruijn-symbol '() '(b a))
;(next-deBruijn-symbol '(a b) '(b a))
;(next-deBruijn-symbol '(a b b a a) '(b a))
;(next-deBruijn-symbol '(a b b a a a b a b b b) '(b a))
;(next-deBruijn-symbol '(a b b a a a b a b b b b a a b b a b a a a a) '(b a))
;(next-deBruijn-symbol '(a b b a a a b a b b b b a a b b a b a a a a a b b b a b b a a b a a b a b a b b b b b) '(b a))
;(next-deBruijn-symbol '(a b b a a a b a b b b b a a b b a b a a a a a b b b a b b a a b a a b a b a b b b b b b a) '(b a))
#|(define (next-deBruijn-symbol l a (n (length (car (remaining-subsequences l a)))))
  (if (= n (length (car (remaining-subsequences l a))))
      (shortest-list
       (map (lambda (x)
              (next-deBruijn-symbol
               (append l (drop x (overlap l x)))
               a
               n))
            (remaining-subsequences l a)))
       l))
|#
